# Read in data ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
setwd("C:/Users/Mihai/Desktop/R Notebooks/notebooks/UG-met")
<- "C:/Users/Mihai/Desktop/R Notebooks/notebooks/UG-met"
folder <- readr::read_csv("PRE_answers_2022.csv") pre
Rows: 2057 Columns: 7
-- Column specification ------------------------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (2): Username, Accepted
dbl (4): Alocator, Decident, Feedback, Round
dttm (1): Timestamp
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
<- readr::read_csv("POST_answers_2022.csv") post
Rows: 1944 Columns: 7
-- Column specification ------------------------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (2): Username, Accepted
dbl (4): Alocator, Decident, Feedback, Round
dttm (1): Timestamp
i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## ID df
<- rio::import(file.path(folder, "Scale complete triate Sofi pa4.xlsx"),
id_df skip = 0, colNames = FALSE, which = "incadrari")
New names:
* `` -> ...1
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5
* ...
<- id_df[, 1:4]
id_df colnames(id_df) <- c("Grup", "Cond", "id", "email")
<-
id_df %>%
id_df ::remove_empty("rows") %>%
janitor::mutate(id = stringr::str_remove(id, "^0+"), # remove leading zeros
dplyrid = stringr::str_remove_all(id, "[[:blank:]]"), # remove any white space
id = toupper(id)) %>%
::mutate(Cond = stringr::str_replace(Cond, "12CONTROL", "CONTROL"), # fix typo
dplyrGrup = stringr::str_replace(Grup, "burnout", "Burnout"),
Grup = stringr::str_replace(Grup, "pop generala", "pop gen"),
Grup = stringr::str_replace(Grup, "old", "pop gen")) %>%
::mutate(Grup = dplyr::if_else(is.na(Grup), "pop gen", Grup))
dplyr
<-
id_df %>%
id_df ::separate(id,
tidyrinto = c("id_num", "Exp_type"),
sep = "(?<=[0-9])(?=[A-Za-z])", # ?<= is "look behind"
remove = FALSE
%>%
) ::select(-id_num) %>%
dplyr::mutate(Exp_type = dplyr::if_else(Exp_type %in% c("A", "B", "C", "D", "E", "R", "X"), "online", Exp_type)) %>%
dplyr::mutate(email = tolower(email),
dplyremail = stringr::str_remove_all(email, "[[:blank:]]"))
# Read in data ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
setwd("C:/Users/Mihai/Desktop/R Notebooks/notebooks/UG-met")
<- rio::import("mail-grup.xlsx", skip = 3)
email_df
<- email_df[1:42, 1:4]
gsr_df names(gsr_df)[1:4] <- c("Group", "Cond", "ID", "email")
<- email_df[181:197, 2:4]
rmn_df names(rmn_df)[1:3] <- c("Nr_Crt", "ID", "email")
$Cond <- rep("EXPERIMENTAL", nrow(rmn_df))
rmn_df# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
–>
# Exclude known test-IDs ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<- c("bica.andreea21@gmail.com", "ioana.r.podina@gmail.com", "test@ro", "rozetadraghici@gmail.com", "ioana.podina@fpse.unibuc.ro",
excluded_id "cociaioana@gmail.com")
<- "PA1"
varstnici_pattern
<-
pre %>%
pre ::filter(!Username %in% excluded_id) %>%
dplyr::filter(!str_detect(Username, varstnici_pattern))
dplyr
<-
post %>%
post ::filter(!Username %in% excluded_id) %>%
dplyr::filter(!str_detect(Username, varstnici_pattern))
dplyr
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Check & Exclude IDs ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
%>%
pre count(Username) %>%
print(n = Inf) # "luciana.haloiu@invingemautismul.ro" has 24 trials instead of 12
%>%
post count(Username) %>%
print(n = Inf)
<-
pre %>%
pre ::group_by(Username) %>% # exclude last 12 trials of "luciana.haloiu@invingemautismul.ro"
dplyr::filter(!(Username == "luciana.haloiu@invingemautismul.ro" & dplyr::row_number() %in% 13:24))
dplyr$Timestamp[pre$Username == "luciana.haloiu@invingemautismul.ro"] # check: 12th trial is at "2020-11-23 16:40:59 UTC" pre
[1] "2020-11-23 16:38:20 UTC" "2020-11-23 16:38:37 UTC" "2020-11-23 16:38:52 UTC" "2020-11-23 16:39:05 UTC" "2020-11-23 16:39:16 UTC"
[6] "2020-11-23 16:39:30 UTC" "2020-11-23 16:39:40 UTC" "2020-11-23 16:39:58 UTC" "2020-11-23 16:40:13 UTC" "2020-11-23 16:40:26 UTC"
[11] "2020-11-23 16:40:39 UTC" "2020-11-23 16:40:59 UTC"
<- data.frame(pre = unique(pre$Username))
pre_ids <- data.frame(post = unique(post$Username))
post_ids <- dplyr::full_join(pre_ids, post_ids, by = c("pre" = "post"), keep = TRUE)
list_ids list_ids
<-
complete_ids %>%
list_ids ::drop_na() %>%
tidyr::mutate(pre = as.character(pre)) %>%
dplyr::pull(pre)
dplyr
# Keep only IDs that have both PRE and POST
<-
pre %>%
pre ::filter(Username %in% complete_ids)
dplyr
<-
post %>%
post ::filter(Username %in% complete_ids)
dplyr
### Radical exclusions (keep only the first 12 observations)
<-
pre %>%
pre group_by(Username) %>%
::filter(row_number() <= 12)
dplyr
<-
post %>%
post group_by(Username) %>%
::filter(row_number() <= 12) dplyr
# some Usernames are emails, some are IDs in form of emails
<-
pre %>%
pre ::mutate(id_user = Username) %>%
dplyr::select(Username, id_user, everything()) %>%
dplyr::mutate(id_user = stringr::str_remove(id_user, "@.*")) %>%
dplyr::mutate(id_user = if_else(stringr::str_detect(id_user, "A10|GSR"), id_user, NA_character_)) %>%
dplyr::mutate(id_user = stringr::str_remove(id_user, "^0+"), # remove leading zeros
dplyrid_user = stringr::str_remove_all(id_user, "[[:blank:]]"), # remove any white space
id_user = toupper(id_user)) %>%
::mutate(Username = tolower(Username),
dplyrUsername = stringr::str_remove_all(Username, "[[:blank:]]"))
<-
post %>%
post ::mutate(id_user = Username) %>%
dplyr::select(Username, id_user, everything()) %>%
dplyr::mutate(id_user = stringr::str_remove(id_user, "@.*")) %>%
dplyr::mutate(id_user = if_else(stringr::str_detect(id_user, "A10|GSR"), id_user, NA_character_)) %>%
dplyr::mutate(id_user = stringr::str_remove(id_user, "^0+"), # remove leading zeros
dplyrid_user = stringr::str_remove_all(id_user, "[[:blank:]]"), # remove any white space
id_user = toupper(id_user)) %>%
::mutate(Username = tolower(Username),
dplyrUsername = stringr::str_remove_all(Username, "[[:blank:]]"))
# Exclude subjects from A10 (RMN sample)
<-
pre %>%
pre ::filter(!str_detect(Username, "a10"))
dplyr
<-
post %>%
post ::filter(!str_detect(Username, "a10"))
dplyr
# Merge
<- dplyr::left_join(pre, id_df, by = c("Username" = "email")) %>%
pre_united ::left_join(., id_df, by = c("id_user" = "id"), suffix = c("", ".x")) %>%
dplyr::mutate(Grup = dplyr::coalesce(Grup, Grup.x),
dplyrCond = dplyr::coalesce(Cond, Cond.x),
Exp_type = dplyr::coalesce(Exp_type, Exp_type.x),
email = dplyr::coalesce(email, email)) %>%
::select(!contains(".x")) %>%
dplyr::filter(!is.na(Grup), !is.na(Cond))
dplyr
<- dplyr::left_join(post, id_df, by = c("Username" = "email")) %>%
post_united ::left_join(., id_df, by = c("id_user" = "id"), suffix = c("", ".x")) %>%
dplyr::mutate(Grup = dplyr::coalesce(Grup, Grup.x),
dplyrCond = dplyr::coalesce(Cond, Cond.x),
Exp_type = dplyr::coalesce(Exp_type, Exp_type.x),
email = dplyr::coalesce(email, email)) %>%
::select(!contains(".x")) %>%
dplyr::filter(!is.na(Grup), !is.na(Cond))
dplyr
# To keep rest of code working
<- pre_united
pre <- post_united
post
<- rbind(pre_united, post_united) %>%
merged_united ::select(Username, Grup, Cond) dplyr
# Compute scores ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# utilizam doar Decident: unfair = 17-24 (6 oferte diferite); fair = 49-54 (6 oferte diferite)
# Define Fair/Unfair
<-
pre %>%
pre ::mutate(Type = cut(Decident, breaks = c(-Inf, 30, Inf), labels = c("Unfair", "Fair")))
dplyr
<-
post %>%
post ::mutate(Type = cut(Decident, breaks = c(-Inf, 30, Inf), labels = c("Unfair", "Fair")))
dplyr
# Compute Percent scores
<-
pre_scores %>%
pre ::add_count(Username, Type, name = "n_Type") %>%
dplyr::count(Username, Type, Accepted, n_Type, name = "n_Accepted_Type", .drop = FALSE) %>% # need .drop = FALSE for missing factor levels leading to 0% Percentages
dplyr::mutate(Percent = 100 * n_Accepted_Type / n_Type) %>%
dplyr::ungroup() %>%
dplyr::complete(Username, Type, Accepted, fill = list(n_Type = 0, n_Accepted_Type = 0, Percent = 0)) %>% # for missing factor levels leading to 0% Percentages
tidyr::filter(Accepted == "Y") %>%
dplyr::mutate(PrePost = rep("Pre", n())) %>%
dplyr::mutate(PrePost= factor(PrePost, levels = c("Pre", "Post")))
dplyr
<-
post_scores %>%
post ::add_count(Username, Type, name = "n_Type") %>%
dplyr::count(Username, Type, Accepted, n_Type, name = "n_Accepted_Type", .drop = FALSE) %>% # need .drop = FALSE for missing factor levels leading to 0% Percentages
dplyr::mutate(Percent = 100 * n_Accepted_Type / n_Type) %>%
dplyr::ungroup() %>%
dplyr::complete(Username, Type, Accepted, fill = list(n_Type = 0, n_Accepted_Type = 0, Percent = 0)) %>% # for missing factor levels leading to 0% Percentages
tidyr::filter(Accepted == "Y") %>%
dplyr::mutate(PrePost = rep("Post", n())) %>%
dplyr::mutate(PrePost = factor(PrePost, levels = c("Pre", "Post")))
dplyr
<- rbind(pre_scores, post_scores) %>%
merged_scores ::left_join(., merged_united, by = "Username")
dplyr
# # Merge - OLD
# merged_scores <- rbind(pre_scores, post_scores)
#
# merged_scores$Username <- tolower(merged_scores$Username) # emails to lower letters to match on
# gsr_df$email <- tolower(gsr_df$email)
# rmn_df$email <- tolower(rmn_df$email)
#
# merged_scores_gsr <- dplyr::left_join(merged_scores, gsr_df, by = c("Username" = "email")) # Merge with emails/cond
# merged_scores_rmn <- dplyr::left_join(merged_scores, rmn_df, by = c("Username" = "email")) # Merge with emails/cond
#
# merged_scores_gsr_rmn <-
# dplyr::left_join(merged_scores_gsr, merged_scores_rmn, by = c("Username", "Type", "Accepted", "n_Type", "n_Accepted_Type", "Percent", "PrePost")) %>%
# dplyr::mutate(Cond = dplyr::coalesce(Cond.x, Cond.y)) %>%
# dplyr::mutate(ID = dplyr::coalesce(ID.x, ID.y))
%>%
merged_scores ::filter(Grup == "pop gen", Cond == "EXPERIMENTAL") %>%
dplyr::grouped_ggwithinstats(
ggstatsplotdata = .,
x = PrePost,
y = Percent,
grouping.var = Type,
type = "parametric",
pairwise.comparisons = TRUE,
pairwise.display = "all",
annotation.args = list(title = "Populatie Genearala - TR"))
%>%
merged_scores ::filter(Grup == "pop gen", Cond == "CONTROL") %>%
dplyr::grouped_ggwithinstats(
ggstatsplotdata = .,
x = PrePost,
y = Percent,
grouping.var = Type,
type = "parametric",
pairwise.comparisons = TRUE,
pairwise.display = "all",
annotation.args = list(title = "Populatie Genearala - CTRL"))
%>%
merged_scores ::filter(Grup == "PTSD", Cond == "EXPERIMENTAL") %>%
dplyr::grouped_ggwithinstats(
ggstatsplotdata = .,
x = PrePost,
y = Percent,
grouping.var = Type,
type = "np",
pairwise.comparisons = TRUE,
pairwise.display = "all",
annotation.args = list(title = "PTSD - TR"))
%>%
merged_scores ::filter(Grup == "PTSD", Cond == "CONTROL") %>%
dplyr::grouped_ggwithinstats(
ggstatsplotdata = .,
x = PrePost,
y = Percent,
grouping.var = Type,
type = "np",
pairwise.comparisons = TRUE,
pairwise.display = "all",
annotation.args = list(title = "PTSD - CTRL"))
%>%
merged_scores ::filter(Grup == "Burnout", Cond == "EXPERIMENTAL") %>%
dplyr::grouped_ggwithinstats(
ggstatsplotdata = .,
x = PrePost,
y = Percent,
grouping.var = Type,
type = "np",
pairwise.comparisons = TRUE,
pairwise.display = "all",
annotation.args = list(title = "Burnout - TR"))
%>%
merged_scores ::filter(Grup == "Burnout", Cond == "CONTROL") %>%
dplyr::grouped_ggwithinstats(
ggstatsplotdata = .,
x = PrePost,
y = Percent,
grouping.var = Type,
type = "np",
pairwise.comparisons = TRUE,
pairwise.display = "all",
annotation.args = list(title = "Burnout - CTRL"))
R version 4.1.0 (2021-05-18)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8.1 x64 (build 9600)
Matrix products: default
locale:
[1] LC_COLLATE=Romanian_Romania.1250 LC_CTYPE=Romanian_Romania.1250 LC_MONETARY=Romanian_Romania.1250 LC_NUMERIC=C
[5] LC_TIME=Romanian_Romania.1250
system code page: 1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] statsExpressions_1.1.0 ggstatsplot_0.8.0 rlang_0.4.11 broom_0.7.9 rstatix_0.7.0 rio_0.5.27
[7] scales_1.1.1 ggpubr_0.4.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
[13] readr_2.0.1 tidyr_1.1.3 tibble_3.1.4 ggplot2_3.3.5 tidyverse_1.3.1 papaja_0.1.0.9997
[19] pacman_0.5.1
loaded via a namespace (and not attached):
[1] estimability_1.3 ggprism_1.0.3 GGally_2.1.2 lavaan_0.6-9 coda_0.19-4
[6] bit64_4.0.5 knitr_1.33 multcomp_1.4-17 data.table_1.14.0 rpart_4.1-15
[11] hardhat_0.1.6 generics_0.1.0 GPfit_1.0-8 TH.data_1.0-10 future_1.22.1
[16] correlation_0.7.0 bit_4.0.4 tzdb_0.1.2 xml2_1.3.2 lubridate_1.7.10
[21] assertthat_0.2.1 gower_0.2.2 WRS2_1.1-3 xfun_0.25 jquerylib_0.1.4
[26] hms_1.1.0 evaluate_0.14 fansi_0.5.0 dbplyr_2.1.1 readxl_1.3.1
[31] igraph_1.2.6 DBI_1.1.1 tmvnsim_1.0-2 Rsolnp_1.16 htmlwidgets_1.5.3
[36] reshape_0.8.8 kSamples_1.2-9 stats4_4.1.0 Rmpfr_0.8-4 paletteer_1.4.0
[41] ellipsis_0.3.2 backports_1.2.1 pbivnorm_0.6.0 insight_0.14.4 prismatic_1.0.0
[46] RcppParallel_5.1.4 vctrs_0.3.8 abind_1.4-5 cachem_1.0.6 withr_2.4.2
[51] vroom_1.5.4 checkmate_2.0.0 emmeans_1.6.3 archive_1.1.0 fdrtool_1.2.16
[56] parsnip_0.1.7 mnormt_2.0.2 cluster_2.1.2 mi_1.0 crayon_1.4.1
[61] labeling_0.4.2 recipes_0.1.16 pkgconfig_2.0.3 SuppDists_1.1-9.5 nlme_3.1-152
[66] nnet_7.3-16 globals_0.14.0 lifecycle_1.0.1 MatrixModels_0.5-0 sandwich_3.0-1
[71] kutils_1.70 modelr_0.1.8 cellranger_1.1.0 datawizard_0.2.0.1 Matrix_1.3-4
[76] yardstick_0.0.8 regsem_1.8.0 mc2d_0.1-21 carData_3.0-4 boot_1.3-28
[81] zoo_1.8-9 reprex_2.0.1 base64enc_0.1-3 png_0.1-7 PMCMRplus_1.9.0
[86] parameters_0.14.0 pROC_1.18.0 tune_0.1.6 workflows_0.2.3 multcompView_0.1-8
[91] arm_1.11-2 parallelly_1.27.0 jpeg_0.1-9 rockchalk_1.8.144 ggsignif_0.6.2
[96] memoise_2.0.0 magrittr_2.0.1 plyr_1.8.6 compiler_4.1.0 RColorBrewer_1.1-2
[101] lme4_1.1-27.1 snakecase_0.11.0 cli_3.0.1 DiceDesign_1.9 listenv_0.8.0
[106] patchwork_1.1.1 pbapply_1.4-3 htmlTable_2.2.1 Formula_1.2-4 MASS_7.3-54
[111] tidyselect_1.1.1 stringi_1.7.4 lisrelToR_0.1.4 sem_3.1-11 yaml_2.2.1
[116] OpenMx_2.19.6 latticeExtra_0.6-29 ggrepel_0.9.1 semTools_0.5-5 grid_4.1.0
[121] sass_0.4.0 tools_4.1.0 future.apply_1.8.1 parallel_4.1.0 matrixcalc_1.0-5
[126] rstudioapi_0.13 foreach_1.5.1 foreign_0.8-81 janitor_2.1.0 gridExtra_2.3
[131] ipmisc_6.0.2 prodlim_2019.11.13 pairwiseComparisons_3.1.6 farver_2.1.0 digest_0.6.28
[136] lava_1.6.10 BWStest_0.2.2 Rcpp_1.0.7 car_3.0-11 BayesFactor_0.9.12-4.2
[141] performance_0.7.3 httr_1.4.2 psych_2.1.6 effectsize_0.4.5 poLCA_1.4.1
[146] colorspace_2.0-2 rvest_1.0.1 XML_3.99-0.7 fs_1.5.0 truncnorm_1.0-8
[151] splines_4.1.0 rematch2_2.1.2 xtable_1.8-4 gmp_0.6-2 jsonlite_1.7.2
[156] nloptr_1.2.2.2 corpcor_1.6.9 timeDate_3043.102 glasso_1.11 zeallot_0.1.0
[161] ipred_0.9-11 R6_2.5.1 Hmisc_4.5-0 lhs_1.1.1 pillar_1.6.3
[166] htmltools_0.5.2 glue_1.4.2 fastmap_1.1.0 minqa_1.2.4 class_7.3-19
[171] codetools_0.2-18 mvtnorm_1.1-2 furrr_0.2.3 utf8_1.2.2 bslib_0.3.0
[176] lattice_0.20-44 dials_0.0.9 curl_4.3.2 gtools_3.9.2 zip_2.2.0
[181] openxlsx_4.2.4 survival_3.2-13 rmarkdown_2.10 qgraph_1.6.9 munsell_0.5.0
[186] semPlot_1.1.2 rsample_0.1.0 iterators_1.0.13 haven_2.4.3 reshape2_1.4.4
[191] gtable_0.3.0 bayestestR_0.11.0
A work by Claudiu Papasteri